HPAVC/HPAVC CD-ROM.iso/DEZIP15.ARJ/DEZIP.PAS

Pascal/Delphi Source File | 1989-03-11 | 40KB | 1,193 lines

Program DeZip;

{   DeZip v1.5 (C) Copyright 1989 by R. P. Byrne                              }
{                                                                             }
{   This is a "bare-bones" program to extract files from ZIP archives.        }
{   By "bare-bones", I mean that there is no facility included to do anything }
{   but extraction (ie. no echo to console, no send to printer, etc.).        }
{   If relative pathnames are stored in the Zip file, make sure all of the    }
{   required directories exist on your system before attempting an            }
{   extraction.                                                               }

{$M 10240, 0, 0}           { Stack, Min. Heap, Max. Heap}
{$F+}                      { Force far calls }

Uses
   Dos,
   Crt,
   MemAlloc,
   StrProcs;

Const
   COPYRIGHT = 'DeZip (C) Copyright 1989 by R. P. Byrne';
   VERSION   = 'Version 1.5 - Compiled on March 11, 1989';

{ Stuff needed generically by all uncompression methods }

Const
   MAXNAMES = 20;

Var
   InFileSpecs :  Array[1..MAXNAMES] of String;   { Input file specifications }
   MaxSpecs    :  Word;        { Total number of entries in InFileSpecs array }
   OutPath     :  String;      { Output path specification                    }

   TenPercent  :  LongInt;

{ Define ZIP file header types }

Const
   LOCAL_FILE_HEADER_SIGNATURE = $04034B50;

Type
   Local_File_Header_Type = Record
                             { Signature              :  LongInt; }
                               Extract_Version_Reqd   :  Word;
                               Bit_Flag               :  Word;
                               Compress_Method        :  Word;
                               Last_Mod_Time          :  Word;
                               Last_Mod_Date          :  Word;
                               Crc32                  :  LongInt;
                               Compressed_Size        :  LongInt;
                               Uncompressed_Size      :  LongInt;
                               Filename_Length        :  Word;
                               Extra_Field_Length     :  Word;
                            end;

Const
   CENTRAL_FILE_HEADER_SIGNATURE = $02014B50;

Type
   Central_File_Header_Type = Record
                               { Signature            :  LongInt; }
                                 MadeBy_Version       :  Word;
                                 Extract_Version_Reqd :  Word;
                                 Bit_Flag             :  Word;
                                 Compress_Method      :  Word;
                                 Last_Mod_Time        :  Word;
                                 Last_Mod_Date        :  Word;
                                 Crc32                :  LongInt;
                                 Compressed_Size      :  LongInt;
                                 Uncompressed_Size    :  LongInt;
                                 Filename_Length      :  Word;
                                 Extra_Field_Length   :  Word;
                                 File_Comment_Length  :  Word;
                                 Starting_Disk_Num    :  Word;
                                 Internal_Attributes  :  Word;
                                 External_Attributes  :  LongInt;
                                 Local_Header_Offset  :  LongInt;
                              End;

Const
   END_OF_CENTRAL_DIR_SIGNATURE = $06054B50;

Type
   End_of_Central_Dir_Type =  Record
                               { Signature               :  LongInt; }
                                 Disk_Number             :  Word;
                                 Central_Dir_Start_Disk  :  Word;
                                 Entries_This_Disk       :  Word;
                                 Total_Entries           :  Word;
                                 Central_Dir_Size        :  LongInt;
                                 Start_Disk_Offset       :  LongInt;
                                 ZipFile_Comment_Length  :  Word;
                              end;

Const
   CRC_32_TAB : Array[0..255] of LongInt = (
$00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
$0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,
$1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
$136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5,
$3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
$35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
$26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
$2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d,
$76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
$7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
$6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,
$65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
$4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,
$4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,
$5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
$5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,
$edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683,
$e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
$f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7,
$fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
$d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
$d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79,
$cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f,
$c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
$9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
$95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,
$86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
$88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,
$a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db,
$aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
$bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf,
$b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
);

Const
   BUFSIZE       = 8192;           { Size of buffers for I/O }

Type
   BufPtr        = ^BufType;
   BufType      = Array[1..BUFSIZE] of Byte;

Var
   ZipName       :  String;         { Name of Zip file to be processed }
   ZipFile       :  File;           { Zip file variable }
   EndFile       :  Boolean;        { End of file indicator for ZipFile }
   ZipBuf        :  BufPtr;         { Input buffer for ZipFile }
   ZipPtr        :  Word;           { Index for ZipFile input buffer }
   ZipCount      :  Word;           { Count of bytes in ZipFile input buffer }

   ExtFile       :  File;           { Output file variable }
   ExtBuf        :  BufPtr;         { Output buffer for ExtFile }
   ExtPtr        :  Word;           { Index for ExtFile output buffer }
   ExtCount      :  LongInt;        { Count of characters written to output }

   LocalHdr       :  Local_File_Header_Type;  { Storage for a local file hdr }
   Hdr_FileName   : String;
   Hdr_ExtraField : String;
   Hdr_Comment    : String;

   Crc32Val      :  LongInt;        { Running CRC (32 bit) value }

   Bytes_To_Go   :  LongInt;        { Bytes left to process in compressed file }


{ Stuff needed for unSHRINKing }

Const
   MINCODESIZE    =    9;
   MAXCODESIZE    =   13;
   SPECIAL        =  256;
   FIRSTFREE      =  257;
   LZW_TABLE_SIZE =  (1 SHL MAXCODESIZE) - 1;      { 0..8191 }
   LZW_STACK_SIZE =  (1 SHL MAXCODESIZE) - 1;      { 0..8191 }

Type

   LZW_Table_Rec  =  Record
                        Prefix      :  Integer;
                        Suffix      :  Byte;
                        ChildCount  :  Word;  { If ChildCount = 0 then leaf node }
                     end;
   LZW_Table_Ptr  =  ^LZW_Table_Type;
   LZW_Table_Type =  Array[0..LZW_TABLE_SIZE] of LZW_Table_Rec;

   FreeListPtr    =  ^FreeListArray;
   FreeListArray  =  Array[FIRSTFREE..LZW_TABLE_SIZE] of Word;

   StackPtr       =  ^StackType;
   StackType      =  Array[0..LZW_STACK_SIZE] of Word;

Var
   LZW_Table   :  LZW_Table_Ptr; { Code table for LZW decoding                }
   FreeList    :  FreeListPtr;   { List of free table entries                 }
   NextFree    :  Word;          { Index for free list array                  }
                                 {   FreeList^[NextFree] always contains the  }
                                 {   index of the next available entry in     }
                                 {   the LZW Prefix:Suffix table (LZW_Table^) }
   LZW_Stack   :  StackPtr;      { A stack used to build decoded strings      }
   StackIdx    :  Word;          { Stack array index variable                 }
                                 {   StackIdx always points to the next       }
                                 {   available entry in the stack             }
   SaveByte    :  Byte;          { Our input code buffer - 1 byte long }
   BitsLeft    :  Byte;          { Unprocessed bits in the input code buffer }
   FirstCh     :  Boolean;       { Flag indicating first char being processed }


{ Stuff needed for unREDUCEing }

Type
   FollowerSet    =  Record
                        SetSize  :  Word;
                        FSet     :  Array[0..31] of Byte;
                     end;
   FollowerPtr    =  ^FollowerArray;
   FollowerArray  =  Array[0..255] of FollowerSet;

   StreamPtr      =  ^StreamArray;
   StreamArray    =  Array[0..4095] of Byte;

Var
   Followers   :  FollowerPtr;
   Stream      :  StreamPtr;     { The output stream }
   StreamIdx   :  Word;          { Always points to next pos. to be filled }
   State       :  Byte;
   Len         :  Word;
   V           :  Byte;

{ --------------------------------------------------------------------------- }

Procedure Abort(Msg : String);
Begin
   Writeln;
   Writeln(Msg);
   Writeln('Returning to DOS');
   Writeln;
   Halt;
end {Abort};

{ --------------------------------------------------------------------------- }

Procedure Syntax;
Begin
   Writeln('Usage:  DeZip ZipFileName [OutPathSpec] [FileSpec [...]]');
   Writeln;
   Writeln('Optional file specifications may contain DOS ');
   Writeln('wildcard characters.');
   Writeln;
   Writeln('If no filespecs are entered, *.* is assumed.');
   Writeln;
   Halt;
End;

{ --------------------------------------------------------------------------- }

Function HexLInt(L : LongInt) : String;
Type
   HexType  = Array [0..15] of Char;
Const
   HexChar : HexType = ('0','1','2','3','4','5','6','7',
                        '8','9','A','B','C','D','E','F');
Begin
   HexLInt  := HexChar[(L AND $F0000000) SHR 28] +
               HexChar[(L AND $0F000000) SHR 24] +
               HexChar[(L AND $00F00000) SHR 20] +
               HexChar[(L AND $000F0000) SHR 16] +
               HexChar[(L AND $0000F000) SHR 12] +
               HexChar[(L AND $00000F00) SHR  8] +
               HexChar[(L AND $000000F0) SHR  4] +
               HexChar[(L AND $0000000F)       ] +
               'h';
end {HexLInt};

{ --------------------------------------------------------------------------- }

Function IO_Test : Boolean;
Var
   ErrorCode   :  Word;
   CodeStr     :  String;
   Ok          :  Boolean;
Begin
   Ok := TRUE;
   ErrorCode := IOResult;
   If ErrorCode <> 0 then begin
      Ok := FALSE;
      Case ErrorCode of
           2 : Writeln('File Not Found');
           3 : Writeln('Path Not Found');
           5 : Writeln('Access Denied');
         101 : Writeln('Disk Full');
        else   Writeln('I/O Error # ', ErrorCode);
      end {Case};
   end {if};
   IO_Test := Ok;
end {IO_Test};

{ --------------------------------------------------------------------------- }

Procedure Load_Parms;
Var
   I      : Word;
   Name   : String;
   DosDTA : SearchRec;
Begin
   I := ParamCount;
   If I < 1 then
      Syntax;

   ZipName := ParamStr(1);
   For I := 1 to Length(ZipName) do
      ZipName[I] := UpCase(ZipName[I]);
   If Pos('.', ZipName) = 0 then
      ZipName := ZipName  + '.ZIP';

   MaxSpecs := 0;
   OutPath := '';
   I := 1;
   While I < ParamCount do begin
      Inc(I);
      Name := ParamStr(I);
      If Name[length(Name)] = '\' then
         Delete(Name, length(Name), 1);
      FindFirst(Name, DIRECTORY, DosDTA);     { outpath spec? }
      If DosError = 0 then begin
         If (DosDTA.Attr AND DIRECTORY) <> 0 then begin   { yup }
            OutPath := Name;
            If OutPath[Length(OutPath)] <> '\' then
               OutPath := OutPath + '\';
         end {then}
         else begin
            If MaxSpecs < MAXNAMES then begin
               Inc(MaxSpecs);
               InFileSpecs[MaxSpecs] := Name;
            end {if};
         end {if};
      end {then}
      else begin
         If MaxSpecs < MAXNAMES then begin
            Inc(MaxSpecs);
            InFileSpecs[MaxSpecs] := Name;
         end {if};
      end {if}
   end {while};

   If MaxSpecs = 0 then begin
      MaxSpecs := 1;
      InFileSpecs[1] := '*.*';
   end {if};

end {Load_Parms};

{ --------------------------------------------------------------------------- }

Procedure Initialize;
Var
   Code : Integer;
Begin
   Code := Malloc(ZipBuf, SizeOf(ZipBuf^)) OR
           Malloc(ExtBuf, SizeOf(ExtBuf^));
   If Code <> 0 then
      Abort('Not enough memory available to allocate I/O buffers!');
end {Initialize};

{ --------------------------------------------------------------------------- }

{ Converted to Turbo Pascal (tm) V4.0 March, 1988 by J.R.Louvau               }
{ COPYRIGHT (C) 1986 Gary S. Brown.  You may use this program, or             }
{ code or tables extracted from it, as desired without restriction.           }
{                                                                             }
{ First, the polynomial itself and its table of feedback terms.  The          }
{ polynomial is                                                               }
{ X^32+X^26+X^23+X^22+X^16+X^12+X^11+X^10+X^8+X^7+X^5+X^4+X^2+X^1+X^0         }
{                                                                             }
{ Note that we take it "backwards" and put the highest-order term in          }
{ the lowest-order bit.  The X^32 term is "implied"; the LSB is the           }
{ X^31 term, etc.  The X^0 term (usually shown as "+1") results in            }
{ the MSB being 1.                                                            }
{                                                                             }
{ Note that the usual hardware shift register implementation, which           }
{ is what we're using (we're merely optimizing it by doing eight-bit          }
{ chunks at a time) shifts bits into the lowest-order term.  In our           }
{ implementation, that means shifting towards the right.  Why do we           }
{ do it this way?  Because the calculated CRC must be transmitted in          }
{ order from highest-order term to lowest-order term.  UARTs transmit         }
{ characters in order from LSB to MSB.  By storing the CRC this way,          }
{ we hand it to the UART in the order low-byte to high-byte; the UART         }
{ sends each low-bit to hight-bit; and the result is transmission bit         }
{ by bit from highest- to lowest-order term without requiring any bit         }
{ shuffling on our part.  Reception works similarly.                          }
{                                                                             }
{ The feedback terms table consists of 256, 32-bit entries.  Notes:           }
{                                                                             }
{     The table can be generated at runtime if desired; code to do so         }
{     is shown later.  It might not be obvious, but the feedback              }
{     terms simply represent the results of eight shift/xor opera-            }
{     tions for all combinations of data and CRC register values.             }
{                                                                             }
{     The values must be right-shifted by eight bits by the "updcrc"          }
{     logic; the shift must be unsigned (bring in zeroes).  On some           }
{     hardware you could probably optimize the shift in assembler by          }
{     using byte-swap instructions.                                           }
{     polynomial $edb88320                                                    }
{                                                                             }

Function UpdC32(Octet: Byte; Crc: LongInt) : LongInt;
Var
   L : LongInt;
   W : Array[1..4] of Byte Absolute L;
Begin

   UpdC32 := CRC_32_TAB[Byte(Crc XOR LongInt(Octet))] XOR ((Crc SHR 8) AND $00FFFFFF);

end {UpdC32};

{ --------------------------------------------------------------------------- }

Procedure Read_Zip_Block;
Begin
   BlockRead(ZipFile, ZipBuf^, BUFSIZE, ZipCount);
   If ZipCount = 0 then
      EndFile := TRUE;
   ZipPtr := 1;
End {Read_Zip_Block};

{ --------------------------------------------------------------------------- }

Procedure Write_Ext_Block;
Begin
   If ExtPtr > 1 then begin
      BlockWrite(ExtFile, ExtBuf^, Pred(ExtPtr));
      If NOT IO_Test then
         Halt;
      ExtPtr := 1;
   end {if};
End {Write_Ext_Block};

{ --------------------------------------------------------------------------- }

Procedure Open_Zip;
Begin
   Assign(ZipFile, ZipName);
   FileMode := 64;  { Read Only / Deny None }
   {$I-} Reset(ZipFile, 1) {$I+};
   If NOT IO_Test then
      Halt;
   EndFile := FALSE;
   Read_Zip_Block;
End {Open_Zip};

{ --------------------------------------------------------------------------- }

Function Open_Ext : Boolean;
Begin
   Assign(ExtFile, OutPath + Hdr_FileName);
   FileMode := 66;  { Read & Write / Deny None }
   {$I-} Rewrite(ExtFile, 1) {$I+};
   If NOT IO_Test then
      Open_Ext := FALSE
   else begin
      ExtPtr := 1;
      Open_Ext := TRUE;
   end {if};
end {Open_Ext};

{ --------------------------------------------------------------------------- }

Function Get_Zip : Integer;
Begin
   If ZipPtr > ZipCount then
      Read_Zip_Block;

   If EndFile then
      Get_Zip := -1
   else begin
      Get_Zip := ZipBuf^[ZipPtr];
      Inc(ZipPtr);
   end {if};
end {Get_Zip};

{ --------------------------------------------------------------------------- }

Procedure Put_Ext(C : Byte);
Begin
   Crc32Val := UpdC32(C, Crc32Val);
   ExtBuf^[ExtPtr] := C;
   Inc(ExtPtr);
   Inc(ExtCount);
   If ExtPtr > BUFSIZE then
      Write_Ext_Block;
end {Put_Ext};

{ --------------------------------------------------------------------------- }

Procedure Close_Zip;
Begin
   {$I-} Close(Zipfile) {$I+};
   If IO_Test then ;
end {Close_Zip};

{ --------------------------------------------------------------------------- }

Procedure Close_Ext;
Type
   TimeDateRec = Record
                    Time : Word;
                    Date : Word;
                 end {record};
Var
   TimeDate      : TimeDateRec;
   TimeDateStamp : LongInt Absolute TimeDate;
Begin
   Write_Ext_Block;
   TimeDate.Time := LocalHdr.Last_Mod_Time;
   TimeDate.Date := LocalHdr.Last_Mod_Date;
   SetFTime(ExtFile, TimeDateStamp);
   {$I-} Close(ExtFile) {$I+};
   If IO_Test then ;
   GotoXY(1, WhereY);
   Write(ExtCount);
   GotoXY(1, WhereY);
end {Close_Ext};

{ --------------------------------------------------------------------------- }

Procedure FSkip(Offset : LongInt);
Var
   Rec : LongInt;
Begin
   If (Offset + ZipPtr) <= ZipCount then
      Inc(ZipPtr, Offset)
   else begin
      Rec := FilePos(ZipFile) + (Offset - (ZipCount - ZipPtr) - 1);
      {$I-} Seek(ZipFile, Rec) {$I+};
      If NOT IO_Test then
         Halt;
      Read_Zip_Block;
   end {if};
end {FSkip};

{ --------------------------------------------------------------------------- }

Procedure FRead(Var Buf; RecLen : Word);
Var
   I  :  Word;
   B  :  Array[1..MaxInt] of Byte Absolute Buf;
Begin
   For I := 1 to RecLen do
      B[I] := Get_Zip;
end {FRead};

{ --------------------------------------------------------------------------- }

Function Read_Local_Hdr : Boolean;
Var
   Sig : LongInt;
Begin
   If EndFile then
      Read_Local_Hdr := FALSE
   else begin
      FRead(Sig, SizeOf(Sig));
      If Sig = CENTRAL_FILE_HEADER_SIGNATURE then begin
         Read_Local_Hdr := FALSE;
         EndFile        := TRUE;
      end {then}
      else begin
         If Sig <> LOCAL_FILE_HEADER_SIGNATURE then
            Abort('Missing or invalid local file header in ' + ZipName);
         FRead(LocalHdr, SizeOf(LocalHdr));
         With LocalHdr do begin
            If FileName_Length > 255 then
               Abort('Filename of compressed file exceeds 255 characters!');
            FRead(Hdr_FileName[1], FileName_Length);
            Hdr_FileName[0] := Chr(FileName_Length);
            If Extra_Field_Length > 255 then
               Abort('Extra field of compressed file exceeds 255 characters!');
            FRead(Hdr_ExtraField[1], Extra_Field_Length);
            Hdr_ExtraField[0] := Chr(Extra_Field_Length);
         end {with};
         Read_Local_Hdr := TRUE;
      end {if};
   end {if};
end {Read_Local_Hdr};

{ --------------------------------------------------------------------------- }

Function Get_Compressed : Integer;
Var
   PctDone : Integer;
Begin
   If Bytes_To_Go = 0 then
      Get_Compressed := -1
   else begin
      Get_Compressed := Get_Zip;
      If Bytes_To_Go mod TenPercent = 0 then begin
         PctDone := 100 - Round( 100 * (Bytes_To_Go / LocalHdr.Compressed_Size));
         GotoXY(WhereX - 4, WhereY);
         Write(PctDone:3, '%');
      end {if};
      Dec(Bytes_To_Go);
   end {if};
end {Get_Compressed};

{ --------------------------------------------------------------------------- }

Function LZW_Init : Boolean;
Var
   RC       :  Word;
   I        :  Word;
Label
   Exit;
Begin
   { Initialize LZW Table }
   RC := Malloc(LZW_Table, SizeOf(LZW_Table^));
   If RC <> 0 then begin
      LZW_Init := FALSE;
      Goto Exit;
   end {if};
   For I := 0 to LZW_TABLE_SIZE do begin
      With LZW_Table^[I] do begin
         Prefix     := -1;
         If I < 256 then
            Suffix  := I
         else
            Suffix  := 0;
         ChildCount := 0;
      end {with};
   end {for};

   RC := Malloc(FreeList, SizeOf(FreeList^));
   If RC <> 0 then begin
      LZW_Init := FALSE;
      Goto Exit;
   end {if};
   For I := FIRSTFREE to LZW_TABLE_SIZE do
      FreeList^[I] := I;
   NextFree := FIRSTFREE;

   { Initialize the LZW Character Stack }
   RC := Malloc(LZW_Stack, SizeOf(LZW_Stack^));
   If RC <> 0 then begin
      LZW_Init := FALSE;
      Goto Exit;
   end {if};
   StackIdx := 0;
   LZW_Init := TRUE;

Exit:
end {LZW_Init};

{ --------------------------------------------------------------------------- }

Procedure LZW_Cleanup;
Var
   Code : Word;
Begin
   Code := Dalloc(LZW_Table);
   Code := Dalloc(FreeList);
   Code := Dalloc(LZW_Stack);
end {LZW_Cleanup};

{ --------------------------------------------------------------------------- }

Procedure Clear_LZW_Table;
Var
   I      :  Word;
Begin
   StackIdx := 0;

   For I := FIRSTFREE to LZW_TABLE_SIZE do begin      { Find all leaf nodes }
      If LZW_Table^[I].ChildCount = 0 then begin
         LZW_Stack^[StackIdx] := I;                   { and put each on stack }
         Inc(StackIdx);
      end {if};
   end {for};

   NextFree := Succ(LZW_TABLE_SIZE);

   While StackIdx > 0 do begin                        { clear all leaf nodes }
      Dec(StackIdx);
      I := LZW_Stack^[StackIdx];
      With LZW_Table^[I] do begin
         If LZW_Table^[I].Prefix <> -1 then
            Dec(LZW_Table^[Prefix].ChildCount);
         Prefix     := -1;
         Suffix     :=  0;
         ChildCount :=  0;
      end {with};
      Dec(NextFree);                         { add cleared nodes to freelist }
      FreeList^[NextFree] := I;
   end {while};

End {Clear_LZW_Table};

{ --------------------------------------------------------------------------- }

Procedure Add_To_LZW_Table(Prefix : Integer; Suffix : Byte);
Var
   I  :  Word;
Begin

   If NextFree <= LZW_TABLE_SIZE then begin
      I := FreeList^[NextFree];
      Inc(NextFree);
      LZW_Table^[I].Prefix     := Prefix;
      LZW_Table^[I].Suffix     := Suffix;
      Inc(LZW_Table^[Prefix].ChildCount);
   end {if};

End {Add_To_LZW_Table};

{ --------------------------------------------------------------------------- }

Function Get_Code(CodeSize : Byte) : Integer;
Const
   Mask       :  Array[1..8] of Byte = ($01, $03, $07, $0F, $1F, $3F, $7F, $FF);
   TmpInt     : Integer = 0;
Var
   BitsNeeded : Byte;
   HowMany    : Byte;
   HoldCode   : Integer;
Label
   Exit;
Begin
   If FirstCh then begin               { If first time through ...         }
      TmpInt := Get_Compressed;        { ... then prime the code buffer    }
      If TmpInt = -1 then begin        { If EOF on fill attempt ...        }
         Get_Code := -1;           { ... then return EOF indicator ... }
         Goto Exit;                    { ... and return to caller.         }
      end {if};
      SaveByte := TmpInt;
      BitsLeft := 8;                   { there's now 8 bits in our buffer  }
      FirstCh  := FALSE;
   end {if};

   BitsNeeded := CodeSize;
   HoldCode   := 0;

   While (BitsNeeded > 0) And (TmpInt <> -1) do begin

      If BitsNeeded >= BitsLeft
         then HowMany := BitsLeft         { HowMany <-- Min(BitsLeft, BitsNeeded) }
         else HowMany := BitsNeeded;

      HoldCode := HoldCode OR ((SaveByte AND Mask[HowMany]) SHL (CodeSize - BitsNeeded));
      SaveByte := SaveByte SHR HowMany;
      Dec(BitsNeeded, HowMany);
      Dec(BitsLeft, HowMany);

      If BitsLeft <= 0 then begin         { If no bits left in buffer ...     }
         TmpInt := Get_Compressed;        { ... then attempt to get 8 more.   }
         If TmpInt = -1 then
            Goto Exit;
         SaveByte := TmpInt;
         BitsLeft := 8;
      end {if};

   end {while};

Exit:

   If (BitsNeeded = 0) then               { If we got what we came for ... }
      Get_Code := HoldCode            { ... then return it             }
   else
      Get_Code := -1;                 { ... Otherwise, return EOF      }

end {Get_Code};

{ --------------------------------------------------------------------------- }

Procedure UnShrink;
Var
   Ch       :  Char;
   CodeSize :  Byte;          { Current size (in bits) of codes coming in  }
   CurrCode :  Integer;
   SaveCode :  Integer;
   PrevCode :  Integer;
   BaseChar :  Byte;
Label
   Exit;
Begin
   CodeSize := MINCODESIZE;               { Start with the smallest code size }

   PrevCode := Get_Code(CodeSize);        { Get first code from file          }
   If PrevCode = -1 then                  { If EOF already, then ...          }
      Goto Exit;                          { ... just exit without further ado }
   BaseChar := PrevCode;
   Put_Ext(BaseChar);                      { Unpack the first character        }

   CurrCode := Get_Code(CodeSize);        { Get next code to prime the while loop }

   While CurrCode <> -1 do begin          { Repeat for all compressed bytes   }

      If CurrCode = SPECIAL then begin    { If we've got a "special" code ... }

         CurrCode := Get_Code(CodeSize);
         Case CurrCode of
            1  :  Begin                   { ... and if followed by a 1 ...    }
                     Inc(CodeSize);       { ... then increase code size       }
                  end {1};
            2  :  Begin                   { ... and if followed by a 2 ...    }
                     Clear_LZW_Table;     { ... clear leaf nodes in the table }
                  end {2};
            else  begin                   { ... if neither 1 or 2, discard    }
                     Writeln;
                     Writeln('Encountered code 256 not followed by 1 or 2!');
                     Writeln;
                     Write('Press a key to continue ...');
                     Ch := ReadKey;
                     DelLine;
                     GotoXY(1, WhereY);
                  end {else};
         end {case};

      end {then}
      else begin                          { Not a "special" code              }

         SaveCode := CurrCode;            { Save this code someplace safe...  }

         If CurrCode > LZW_TABLE_SIZE then
            Abort('Invalid code encountered!');

         If (CurrCode >= FIRSTFREE) and (LZW_Table^[CurrCode].Prefix = -1) then begin
            If StackIdx > LZW_STACK_SIZE then begin
               Write_Ext_Block;
               Writeln;
               Writeln('Stack Overflow (', StackIdx, ')!');
               Halt;
            end {if};
            LZW_Stack^[StackIdx] := BaseChar;
            Inc(StackIdx);
            CurrCode := PrevCode;
         end {if};

         While CurrCode >= FIRSTFREE do begin
            If StackIdx > LZW_STACK_SIZE then begin
               Write_Ext_Block;
               Writeln;
               Writeln('Stack Overflow (', StackIdx, ')!');
               Halt;
            end {if};
            LZW_Stack^[StackIdx] := LZW_Table^[CurrCode].Suffix;
            Inc(StackIdx);
            CurrCode := LZW_Table^[CurrCode].Prefix;
         end {while};

         BaseChar := LZW_Table^[CurrCode].Suffix;         { Get last character ...   }
         Put_Ext(BaseChar);

         While (StackIdx > 0) do begin
            Dec(StackIdx);
            Put_Ext(LZW_Stack^[StackIdx]);
         end {while};                     { ... until there are none left     }

         Add_to_LZW_Table(PrevCode, BaseChar);  { Add new entry to table      }

         PrevCode := SaveCode;

      end {if};

      CurrCode := Get_Code(CodeSize);     { Get next code from input stream   }

   end {while};
Exit:
end {UnShrink};

{ --------------------------------------------------------------------------- }

Function Init_UnReduce : Boolean;
Var
   Code : Word;
Label
   Exit;
Begin
   Code := Malloc(Followers, SizeOf(Followers^));
   If Code <> 0 then begin
      Init_UnReduce := FALSE;
      Goto Exit;
   end {if};

   Code := Malloc(Stream, SizeOf(Stream^));
   If Code <> 0 then begin
      Init_UnReduce := FALSE;
      Goto Exit;
   end {if};

   Init_UnReduce := TRUE;

Exit:
end {Init_UnReduce};

{ --------------------------------------------------------------------------- }

Procedure Cleanup_UnReduce;
Var
   Code : Word;
Begin
   Code := Dalloc(Followers);
   Code := Dalloc(Stream);
end {Cleanup_UnReduce};

{ --------------------------------------------------------------------------- }

Function D(X, Y : Byte) : Word;
Var
   tmp : LongInt;
Begin
   X := X SHR (8 - Pred(LocalHdr.Compress_Method));
   Tmp := X * 256;
   D := Tmp + Y + 1;
end {D};

{ --------------------------------------------------------------------------- }

Function F(X : Word) : Byte;
Const
   TestVal : Array[1..4] of Byte = (127, 63, 31, 15);
Begin
   If X = TestVal[Pred(LocalHdr.Compress_Method)] then
      F := 2
   else
      F := 3;
end {F};

{ --------------------------------------------------------------------------- }

Function L(X : Byte) : Byte;
Const
   Mask : Array[1..4] of Byte = ($7F, $3F, $1F, $0F);
Begin
   L := X AND Mask[Pred(LocalHdr.Compress_Method)];
end {L};

{ --------------------------------------------------------------------------- }

Procedure StreamOut(C : Byte);
Begin
   Put_Ext(C);
   Stream^[StreamIdx] := C;
   StreamIdx := Succ(StreamIdx) MOD 4096;
end {StreamOut};

{ --------------------------------------------------------------------------- }

Procedure ScrnchInit;
Begin
   State := 0;
   For StreamIdx := 0 to 4095 do
      Stream^[StreamIdx] := 0;
   StreamIdx := 0;
end {ScrnchInit};

{ --------------------------------------------------------------------------- }

Procedure UnScrnch(C : Byte);
Const
   DLE   =  $90;
Var
   S           :  Integer;
   Count       :  Word;
   OneByte     :  Byte;
   Tmp1        :  LongInt;
Begin
   Case State of
      0  :  begin
               If C = DLE then
                  State := 1
               else
                  StreamOut(C);
            end {0};
      1  :  begin
               If C = 0 then begin
                  StreamOut(DLE);
                  State := 0;
               end {then}
               else begin
                  V     := C;
                  Len   := L(V);
                  State := F(Len);
               end {if};
            end {1};
      2  :  begin
               Inc(Len, C);
               State := 3;
            end {2};
      3  :  begin
               Tmp1 := D(V, C);
               S    := StreamIdx - Tmp1;
               If S < 0 then
                  S := S + 4096;
               Count := Len + 3;
               While Count > 0 do begin
                  OneByte := Stream^[S];
                  StreamOut(OneByte);
                  S := Succ(S) MOD 4096;
                  Dec(Count);
               end {while};
               State := 0;
            end {3};
   end {case};

end {UnScrnch};

{ --------------------------------------------------------------------------- }

Function MinBits(Val : Byte) : Byte;
Begin
   Dec(Val);
   Case Val of
       0..1  : MinBits := 1;
       2..3  : MinBits := 2;
       4..7  : MinBits := 3;
       8..15 : MinBits := 4;
      16..31 : MinBits := 5;
      else     MinBits := 6;
   end {case};
end {MinBits};

{ --------------------------------------------------------------------------- }

Procedure UnReduce;
Var
   LastChar    :  Byte;
   N           :  Byte;
   I, J        :  Word;
   Code        :  Integer;
   Ch          :  Char;
Begin
   For I := 255 downto 0 do begin          { Load follower sets }
      N := Get_Code(6);                { Get size of 1st set }
      Followers^[I].SetSize := N;
      If N > 0 then
         For J := 0 to Pred(N) do
            Followers^[I].FSet[J] := Get_Code(8);
   end {for};

   ScrnchInit;

   LastChar := 0;
   Repeat

      If Followers^[LastChar].SetSize = 0 then begin
         Code := Get_Code(8);
         UnScrnch(Code);
         LastChar := Code;
      end {then}
      else begin
         Code := Get_Code(1);
         If Code <> 0 then begin
            Code := Get_Code(8);
            UnScrnch(Code);
            LastChar := Code;
         end {then}
         else begin
            I := MinBits(Followers^[LastChar].SetSize);
            Code := Get_Code(I);
            UnScrnch(Followers^[LastChar].FSet[Code]);
            LastChar := Followers^[LastChar].FSet[Code];
         end {if};
      end {if};
   Until (ExtCount = LocalHdr.Uncompressed_Size);
   Code := Dalloc(Followers);
end {UnReduce};

{ --------------------------------------------------------------------------- }

Procedure UnZip;
Var
   C  :  Integer;
Begin
   Crc32Val    := $FFFFFFFF;
   Bytes_To_Go := LocalHdr.Compressed_Size;
   FirstCh     := TRUE;

   ExtCount    := 0;

   TenPercent := LocalHdr.Compressed_Size DIV 10;

   Case LocalHdr.Compress_Method of
      0     :  Begin
                  While Bytes_to_go > 0 do
                     Put_Ext(Get_Compressed);
               end {0 = Stored};
      1     :  Begin
                  If LZW_Init then
                     UnShrink
                  else begin
                     Writeln('Not enough memory available to unshrink!');
                     Writeln('Skipping ', Hdr_FileName, ' ...');
                     FSkip(LocalHdr.Compressed_Size);
                     Crc32Val := NOT LocalHdr.Crc32;
                  end {if};
                  LZW_Cleanup;
               end {1 = shrunk};
      2..5  :  Begin
                  If Init_UnReduce then
                     UnReduce
                  else begin
                     Writeln('Not enough memory available to unreduce!');
                     Writeln('Skipping ', Hdr_FileName, ' ...');
                     FSkip(LocalHdr.Compressed_Size);
                     Crc32Val := NOT LocalHdr.Crc32;
                  end {if};
                  Cleanup_UnReduce;
               end {2..5};
      else     Begin
                  Writeln('Unknown compression method used on ', Hdr_FileName);
                  Writeln('Skipping ', Hdr_FileName, ' ...');
                  FSkip(LocalHdr.Compressed_Size);
                  Crc32Val := NOT LocalHdr.Crc32;
               end {else};
   end {case};

   Crc32Val := NOT Crc32Val;
   If Crc32Val <> LocalHdr.Crc32 then begin
      Writeln;
      Writeln('WARNING: File ', OutPath + Hdr_FileName, ' fails CRC check!');
      Writeln('   Stored CRC = ', HexLInt(LocalHdr.Crc32),
              '   Calculated CRC = ', HexLInt(Crc32Val));
   end {if};

end {UnZip};

{ --------------------------------------------------------------------------- }

Procedure Extract_File;
Var
   YesNo  : Char;
   DosDTA : SearchRec;
Label
   Exit;
Begin
   FindFirst(OutPath + Hdr_FileName, ANYFILE, DosDTA);
   If DosError = 0 then begin
      Write('WARNING: ', OutPath + Hdr_FileName, ' already exists.  Overwrite (Y/N)? ');
      YesNo := ReadKey;
      Writeln(YesNo);
      If UpCase(YesNo) <> 'Y' then begin
         FSkip(LocalHdr.Compressed_Size);
         Goto Exit;
      end {if};
   end {if};

   If Open_Ext then begin
      Write('Extracting: ', OutPath + Hdr_FileName, ' ...    ');
      UnZip;
      GotoXY(WhereX - 4, WhereY);
      ClrEol;
      Writeln(' done');
      Close_Ext;
   end {then}
   else begin
      Writeln('Could not open output file ', OutPath + Hdr_FileName, '!  Skipping to next file ...');
      FSkip(LocalHdr.Compressed_Size);
   end {If};
Exit:
end {Extract_File};

{ --------------------------------------------------------------------------- }

Procedure Extract_Zip;
Var
   Match : Boolean;
   I     : Word;
Begin
   Open_Zip;
   While Read_Local_Hdr do begin
      Match := FALSE;
      I := 1;
      Repeat
         If SameFile(InFileSpecs[I], Hdr_FileName) then
            Match := TRUE;
         Inc(I);
      Until Match or (I > MaxSpecs);
      If Match then
         Extract_File
      else
         FSkip(LocalHdr.Compressed_Size);
   end {while};
   Close_Zip;
   GotoXY(1, WhereY);
   ClrEOL;
end;

{ --------------------------------------------------------------------------- }

Begin
   Assign(Output, '');
   Rewrite(Output);
   Writeln;
   Writeln(COPYRIGHT);
   Writeln(VERSION);
   Writeln;
   Load_Parms;   { get command line parameters }
   Initialize;   { one-time initialization }
   Extract_Zip;  { de-arc the file }
end.